SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00016 1 08-24-9412:54ALL MICHELE MOTTINI WINDOWS Error Collection SWAG9408 ⌠ 6b 15 Kx program RunTime213;ππ{π Written by: Michele Mottiniπ TERA S.r.l.π CIS 100040,615ππ}πusesπ WinCrt,π WinTypes,π WinProcs,π Objects;ππ{-------------------- Class TErrCollection : collection with error management }ππ{π You can freely descend your own collection from TErrCollection gettingπ automatically enhanced run time error management.π}ππtypeπ PErrCollection = ^TErrCollection;π TErrCollection = object(TCollection)π procedure Error(Code,Info : integer); virtual;π end;ππprocedure TErrCollection.Error(Code,Info : integer);πvarπ ErrDesc : recordπ ErrCode : integer;π ErrPosHi : word;π ErrPosLo : word;π ErrIndex : integer;π ErrCount : integer;π end;π Buffer : array[0..80] of char;πbeginπ asmπ mov cx,[BP+20]π mov bx,[BP+22]π verr bxπ je @1π mov bx,$FFFFπ mov cx,bxπ jmp @2π@1:π mov es,bxπ mov bx,word ptr es:0π@2:π mov ErrDesc.ErrPosLo,cxπ mov ErrDesc.ErrPosHi,bxπ end;π ErrDesc.ErrCode := 212-Code;π ErrDesc.ErrIndex := Info;π ErrDesc.ErrCount := Count;π WVSPrintF(Buffer,'Runtime error %d at %04X:%04X with index %d; Count=%d',ErrDesc);π MessageBox(0,Buffer,nil,mb_Ok or mb_SystemModal);π halt(0);πend; { Error }ππ{----------------------------------------------------------------------- Main }ππvarπ TestColl : TErrCollection;ππbeginπ TestColl.Init(16,8);π writeln('Now the program call the At() function with an invalid index');π writeln('causing a R/Time error 213');π writeln;π writeln('If you try to find the error position from the address you will');π writeln('go to the correct line!');π TestColl.At(1); { Wrong index: we will get a 213 R/Time error }π TestColl.Done;πend. 2 08-24-9413:23ALL SWAG SUPPORT TEAM objects > 64K SWAG9408 ÷2╒ 47 Kx unit BigArray;ππ{ This unit contains an objects that allows for the creation ofπ arrays larger than 64K. }ππinterfaceππ{ The ifdefs allow compiling under windows or protected mode }ππ{$ifdef windows}πuses WinTypes, WinProcs, WinAPI;π{$else}πuses WinAPI;π{$endif}ππconstπ SegSize = 65536; { Size of a selector }ππ{ Our BigArray object will allow us to allocate large chucks of memoryπ (>64k) and index our way through the items }πtypeπ PBigArray = ^TBigArray;π TBigArray = objectπ MemStart : THandle;π MemOffset : longint;π MemSize : longint;π MaxItems : longint;π ItemSize : longint;π constructor Init(NoItems : longint; Size : Word);π destructor Done; virtual;π procedure PutData(var Item; Index : longint); virtual;π procedure GetData(var Item; Index : longint); virtual;π procedure Resize(NoItems : longint); virtual;π function GetMeMSize : longint; virtual;π end;ππimplementationππconstructor TBigArray.Init(NoItems : longint; Size : Word);π{ Determine the size of the memory we need, allocate using theπ GlobalAlloc() routine, and initialize the fields }πbeginπ MaxItems := NoItems;π ItemSize := Size;π { compute memory size }π MemSize := MaxItems * ItemSize;π { allocate the memory }π MemStart := GlobalAlloc(gmem_Moveable, MemSize);π { any error? }π if MemStart = 0 thenπ RunError(203);ππ MemOffset := 0;πend;ππdestructor TBigArray.Done;π{ Free up the memory }πbeginπ GlobalFree(MemStart);πend;ππprocedure TBigArray.PutData(var Item; Index : longint);π{ Put the item in the allocated memory }πvarπ Sel, Off : word;π P : pointer;π FinishIt : boolean;π TempItemSize : word;πbeginπ if Index >= MaxItems thenπ RunError(201);ππ inc(MemOffset, ItemSize);ππ { compute index into memory }π Index := Index * ItemSize;π { determine the starting selector to access }π Sel := (Index div SegSize) * SelectorInc + MemStart;π { determine the offset into that selector }π Off := Index mod SegSize;ππ if (SegSize - Off) < ItemSize then beginπ TempItemSize := SegSize - Off;π FinishIt := true;π endπ else beginπ TempItemSize := ItemSize;π FinishIt := false;π end;ππ { lock the memory - this only applies to windows }π GlobalLock(Sel);ππ { get the pointer value }π P := ptr(Sel, Off);ππ { move the data into memory }π Move(Item, P^, TempItemSize);ππ { unlock the memory - this only applies to windows }π GlobalUnLock(Sel);ππ if FinishIt then beginπ Sel := Sel + SelectorInc;π Off := 0;π { lock the memory - this only applies to windows }π GlobalLock(Sel);ππ { get the pointer value }π P := ptr(Sel, Off);ππ { move the data into memory }π Move(Item, P^, TempItemSize);ππ { unlock the memory - this only applies to windows }π GlobalUnLock(Sel);π end;πend;ππprocedure TBigArray.GetData(var Item; Index : longint);π{ Get the item out of memory }πvarπ Sel, Off : word;π P : pointer;π FinishIt : boolean;π TempItemSize : word;πbeginπ if Index >= MaxItems thenπ RunError(201);ππ { compute index into memory }π Index := Index * ItemSize;π { determine the starting selector to access }π Sel := (Index div SegSize) * SelectorInc + MemStart;π { determine the offset into that selector }π Off := Index mod SegSize;ππ if (SegSize - Off) < ItemSize then beginπ TempItemSize := SegSize - Off;π FinishIt := true;π endπ else beginπ TempItemSize := ItemSize;π FinishIt := false;π end;ππ { lock the memory - this only applies to windows }π GlobalLock(Sel);ππ { get the pointer value }π P := ptr(Sel, Off);ππ { move the data from memory to the field }π Move(P^, Item, TempItemSize);ππ { unlock the memory - this only applies to windows }π GlobalUnLock(Sel);ππ if FinishIt then beginπ Sel := Sel + SelectorInc;π Off := 0;π { lock the memory - this only applies to windows }π GlobalLock(Sel);ππ { get the pointer value }π P := ptr(Sel, Off);ππ { move the data into memory }π Move(Item, P^, TempItemSize);ππ { unlock the memory - this only applies to windows }π GlobalUnLock(Sel);π end;ππ dec(MemOffset, ItemSize);πend;ππprocedure TBigArray.Resize(NoItems : longint);π{ With a call to GlobalReAlloc() we can resize the array with outπ loosing any data. Here we also reinitialize the fields }πvarπ TempMem : THandle;πbeginππ MaxItems := NoItems;π { compute new memory size }π MemSize := MaxItems * ItemSize;π { resize the memory allocated }π TempMem := GlobalReAlloc(MemStart, MemSize, gmem_Moveable);π { any errors? }π if TempMem = 0 thenπ RunError(203);ππ MemStart := TempMem;πend;ππfunction TBigArray.GetMemSize : longint;π{ returns the current number of bytes allocated for the array }πbeginπ GetMemSize := MemSize;πend;ππend.ππ{------------------------ DEMO PROGRAM --------------------- }ππprogram TestBigArray;ππ{$ifdef Windows}πuses WinDos, WinCrt, WinTypes, WinProcs, BigArray;π{$else}πuses Dos, Crt, WinAPI, BigArray;π{$endif}ππconstπ elnum = 2000;πtypeπ TRec = recordπ i : integer;π r : real;π s : string;π a : array[0..3000] of char;π end;ππvarπ Rec : TRec;π BArray : PBigArray;π X : longint;πbeginππ clrscr;ππ writeln('memory available = ', memavail);ππ new(BArray, Init(elnum, SizeOf(TRec)));ππ for x := 0 to elnum-1 do beginπ Rec.i := x;π BArray^.PutData(Rec, x);π end;ππ for x := elnum-1 downto 0 do beginπ BArray^.GetData(Rec, x);π if x <> Rec.i thenπ writeln(Rec.i);π end;ππ writeln('first size of mem for array = ', BArray^.GetMemSize);ππ{ BArray^.Resize(20000);ππ for x := 10000 to 19999 do beginπ Rec.i := x;π BArray^.PutData(Rec, x);π end;ππ for x := 19999 downto 0 do beginπ BArray^.GetData(Rec, x);π writeln(Rec.i);π end;ππ writeln('second size of mem for array = ', BArray^.GetMemSize);π}π dispose(BArray, Done);π readln;πend.π 3 08-24-9413:24ALL SWAG SUPPORT TEAM HUGE Objects unit SWAG9408 º╧2 16 Kx unit BigStuff;πinterfaceπusesπ Objects,π WinAPI;ππtypeπ PBigData = ^TBigData;π TBigData = object(TObject)π NumRecs: Longint;π RecSize: Word;π Start: Word;π constructor Init(ANumRecs: Longint; ARecSize: Word);π destructor Done; virtual;π procedure GetSetData(Index: Longint; var Data; SetData: Boolean);π virtual;π end;πimplementationππconstructor TBigData.Init(ANumRecs: Longint; ARecSize: Word);πbeginπ TObject.Init;π NumRecs := ANumRecs;π RecSize := ARecSize;π while 65536 mod RecSize <> 0 do Inc(RecSize);π Start := GlobalAlloc(gmem_Moveable, RecSize * NumRecs);π if Start = 0 thenπ Runerror(201);πend;ππdestructor TBigData.Done;πbeginπ TObject.Done;π GlobalFree(Start);πend;ππprocedure TBigData.GetSetData(Index: Longint; var Data; SetData: Boolean);πvarπ Selector, Offset: Word;π P: Pointer;πbeginπ if Index >= NumRecs thenπ beginπ RunError(201);π end;π Index := Index * RecSize;π Selector := (Index div 65536) * SelectorInc + Start;π OffSet := Index mod 65536;π P := GlobalLock(Selector);π P := Ptr(Selector, Offset);π if SetData thenπ Move(Data, P^, RecSize)π elseπ Move(P^, Data, RecSize);π GlobalUnlock(Selector);πend;ππtypeπ PBigInt = ^TBigInt;π TBigInt = object(TBigData)π constructor Init(ANumRecs: Longint);π procedure PutItem(Index: Longint; Value: Integer);π function GetItem(Index: Longint): Integer;π end;ππconstructor TBigInt.Init(ANumRecs: Longint);πbeginπ TBigData.Init(ANumRecs, SizeOf(Integer));πend;ππprocedure TBigInt.PutItem(Index: Longint; Value: Integer);πbeginπ TBigData.GetSetData(Index, Value, True);πend;ππfunction TBigInt.GetItem(Index: Longint): Integer;πvarπ Value: Integer;πbeginπ TBigData.GetSetData(Index, Value, False);π GetItem := Value;πend;ππvarπ BI: TBigInt;πbeginπ BI.Init(200000);π BI.PutItem(100000, 777);π Writeln(BI.GetItem(100000));π BI.Done;πend.π 4 08-24-9413:26ALL NEIL GORIN CTL3D And BORDLG mix SWAG9408 εú
64 Kx {πSome time back, I asked if it was possible to combine CTL3D with BORDLG,πwith the resounding opinion that it wasn't possible to go all the wayπand provide a 3d dialog border, although you could have 3d controlsπin a bordlg using the CTL3dSubClassDlg command.ππAfter much head scratching and many false starts, you'll find thatπthe below unit provides just what I'd been trying to do - i.e.πfully combine BORDLG with CTL3D.ππBasically, all you have to do is add BWCC3D to the USES clause ofπyour main source file and add the command KILLBWCCCTL3D just beforeπyour program shuts down - for example before HALT instructionsπor before <MYAPP>.DONE seems to work. You'll then have to runπResource Workshop, change the class of your dialoguesπfrom BORDLG to BORDLG_CTL3D and make sure you include CTL3D.DLLπwith your application. BORDLG_CTL3D dialogues have the CS_SAVEBITSπflag set, so they save the area beneath them like standard & CTL3Dπdialogue boxes.ππComments and suggestions appreciated, and appologies for the wayπthat this message may have been chopped up.ππNeil Gorinπneil.gorin@nildram.comππ================== BWCC3D.PAS ====================}ππUnit BWCC3d;ππ{********************************************************************}π{ BWCC3D.TPW - Replaces CTL3D.TPW }π{ Based on CTL3D.PAS by Andreas Furrer }π{ }π{ Created 2nd June 1994, Neil Gorin }π{ Internet: neil.gorin@nildram.com }π{ Post: 4 Rookwood Drive, Stevenage, Herts. SG2 8PJ ENGLAND }π{ Telephone: (UK) +44 438 362671 (GMT Evenings and Weekends only) }π{ }π{ Purpose: }π{ }π{ Allows CTL3D frame and effects on BORDLG's }π{ }π{ Use: }π{ }π{ 1: If you currently have CTL3D in your "uses" clause, remove it as }π{ BWCC3D contains all the functionality of CTL3D. Remove any }π{ references to CTL3DREGISTER, CTL3DUNREGISTER and }π{ CTL3DAUTOSUBCLASS from your program. }π{ }π{ 2: Add BWCC3D to your "uses" clause. }π{ }π{ 3: Where your program ends, add the command: KILLBWCCCTL3D }π{ For example, if an ObjectWindows app, before <APPNAME>.DONE }π{ }π{ 4: With Resource Workshop, change the class name of all your }π{ dialogues from BORDLG to BORDLG_CTL3D }π{ }π{********************************************************************}π{ }π{ Tips: }π{ }π{ o If you have version 2.0 of BWCC.DLL (as supplied with BC++4) }π{ you can change the line reading: }π{ }π{ GetClassInfo(Hinstance,'Bordlg',Gorin); }π{ to GetClassInfo(Hinstance,'Bordlg_gray',Gorin); }π{ }π{ This will result in a solid grey background as opposed to }π{ to the normal stippled BWCC effect. }π{ }π{ o If you only want the 3D effect frame and not the 3D }π{ controls, remove the line reading: }π{ }π{ WM_INITDIALOG: CTL3DSUBCLASSDLG(Hwindow,CTL3d_ALL); }π{ }π{********************************************************************}π{ Your comments are welcome - No strings are attached to the use or }π{ distribution of this file. }π{********************************************************************}ππInterfaceπUses Wintypes,winprocs,bwcc,ctl3d;ππconst Ctl3d_Buttons = $0001;π Ctl3d_Listboxes = $0002;π Ctl3d_Edits = $0004;π Ctl3d_Combos = $0008;π Ctl3d_StaticTexts = $0010;π Ctl3d_StaticFrames = $0020;π Ctl3d_All = $ffff;ππfunction Ctl3dGetVer : word;πfunction Ctl3dSubclassDlg(HWindow : HWnd; GrBits : word) : bool;πfunction Ctl3dSubclassDlgEx(HWindow : HWnd; GrBits : word) : bool;πfunction Ctl3dSubclassCtl(HWindow : HWnd) : bool;πfunction Ctl3dCtlColor(DC : HDC; Color : TColorRef) : HBrush;πfunction Ctl3dEnabled : bool;πfunction Ctl3dColorChange : bool;πfunction Ctl3dRegister(Instance : THandle) : bool;πfunction Ctl3dUnregister(Instance : THandle) : bool;πfunction Ctl3dAutoSubclass(Instance : THandle) : bool;πfunction Ctl3dCtlColorEx(Message, wParam : word;π lParam : longint) : HBrush;πfunction Ctl3dDlgFramePaint(Hwindow:Hwnd; Message, wparam:word;π Lparam:Longint):Longint;πProcedure KillBwccCtl3d;ππImplementationππfunction Ctl3dGetVer; external 'Ctl3d' index 1;πfunction Ctl3dSubclassDlg; external 'Ctl3d' index 2;πfunction Ctl3dSubclassCtl; external 'Ctl3d' index 3;πfunction Ctl3dCtlColor; external 'Ctl3d' index 4;πfunction Ctl3dEnabled; external 'Ctl3d' index 5;πfunction Ctl3dColorChange; external 'Ctl3d' index 6;πfunction Ctl3dRegister; external 'Ctl3d' index 12;πfunction Ctl3dUnregister; external 'Ctl3d' index 13;πfunction Ctl3dAutoSubclass; external 'Ctl3d' index 16;πfunction Ctl3dCtlColorEx; external 'Ctl3d' index 18;πfunction Ctl3dDlgFramePaint;external 'Ctl3d' index 20;πfunction Ctl3dSubclassDlgEx;external 'Ctl3d' index 21;πππProcedure KillBwccCtl3d;π{********************************}π{ It is ESSENTIAL that you call }π{ this before your program ends }π{ as otherwise your User Heap }π{ will gradually disappear! }π{********************************}πbeginπ UnRegisterclass('BORDLG_CTL3D',hinstance);π CTL3DUnregister(Hinstance);πend;ππfunction Ctl3dBWCC(HWindow: hwnd; Message, WParam: word;π LParam: longint): longint; export;π{***********************************}π{ Takes control before the }π{ standard BWCCDEFDLGPROC to }π{ paint frame and subclass controls }π{ will gradually disappear! }π{***********************************}πConst WM_PAINTIT=15000;πvar tms:tmsg;πbeginπ If PeekMessage(tms,Hwindow,WM_Paintit,WM_Paintit,PM_REMOVE) thenπ Ctl3dDlgFramePaint(Hwindow,0,0,0);π Case message ofπ WM_SETTEXT,π WM_NCPAINT,π WM_NCACTIVATE: PostMessage(HWindow,WM_PAINTIT,0,0);π WM_INITDIALOG: CTL3DSUBCLASSDLG(Hwindow,CTL3d_ALL);π end;π Ctl3dBwcc:=BWCCDEFDLGPROC(Hwindow,message,wparam,lparam);πend;ππ{ This is run automatically *before* your program gets control }ππvar Gorin:TwndClass;πbeginπ CTL3DRegister(Hinstance);π CTL3DAutoSubclass(Hinstance);π GetClassInfo(Hinstance,'Bordlg',Gorin); {See above for BWCC 2.0 note}π Gorin.Style:=gorin.style or cs_savebits; {Saves bitmap of background}π Gorin.LPSZCLASSNAME:='BORDLG_CTL3D';π Gorin.lpfnwndproc:=@CTL3dBWCC;π Registerclass(gorin);πend.π 5 08-24-9417:55ALL THOMAS WEIDNER Bitmap Startup SWAG9408 ╦_ƒ} 36 Kx {πI 've seen a lot of question here arround, how toπdisplay a bitmap befor starting a program in Windows.πWell, this program shows a bitmap without opening a window.πI 'll send you this program for borland pascal.π(Those who use TPW will have to change the USES declaration)ππ**************************************************************π* Bitmap befor starting the program without opening a window *π**************************************************************π}ππPROGRAM Sample;ππUSES Wintypes, Winprocs, WinCrt, Objects, OWindows, ODialogs;ππ{$R BITMAP.RES }ππTYPEππ PClipWin = ^TClipWin;π TClipWin = OBJECT (TWindow)π Constructor Init (AParent : PWindowsObject; ATitle : PChar;π AMenu : HMenu);π Procedure GetWindowClass (VAR AWndClass : TWndClass); VIRTUAL;π Function GetClassName : PChar; VIRTUAL;π Procedure SetupWindow; VIRTUAL;π END;ππ TClipApp = OBJECT (TApplication)π Procedure InitMainWindow; VIRTUAL;π END;ππ{ *** TClipWin *** }ππConstructor TClipWin.Init (AParent : PWindowsObject; ATitle : PChar;π AMenu : HMenu);π{ ** The main window in this example is a fixed windowπ which cannot be resized or moved ** }πBEGINπ Inherited Init (AParent, ATitle);π{ ** The sample main window will be open over the whole screen ** }π Attr.X := -1;π Attr.Y := -1;π Attr.W := GetSystemMetrics (sm_CxScreen) + 3;π Attr.H := GetSystemMetrics (sm_CyScreen) + 3;π Attr.Style := WS_SYSMENU OR WS_MINIMIZEBOX OR WS_MAXIMIZE;π{ ** The menu must be defined in the resource ** }π Attr.Menu := AMenu;πEND;ππProcedure TClipWin.GetWindowClass (VAR AWndClass : TWndClass);πBEGINπ Inherited GetWindowClass (AWndClass);π{ ** Also the icon of the program must be defined in the resource ** }π AWndClass.HIcon := LoadIcon (HInstance, 'MAINICON');π{ ** This gray background is a standard which is not heavy colored ** }π AWndClass.HBrBackGround := CreateSolidBrush (RGB (128, 128, 128));πEND;ππFunction TClipWin.GetClassName : PChar;πBEGINπ GetClassName := 'Bitmap Sample';πEND;ππProcedure TClipWin.SetupWindow;πBEGINπ Inherited SetupWindow;π{ ** DeleteMenu kills the menu point 'MOVE / RESIZE'. The windows canπ now not be resized or moved. It is fixed ** }π DeleteMenu (GetSystemMenu(HWindow, FALSE), 1, MF_BYPOSITION);πEND;ππ{ *** TClipApp *** }ππProcedure TClipApp.InitMainWindow;πBEGINπ CmdShow := SW_SHOWMAXIMIZED;π MainWindow := New(PClipWin, Init(NIL, 'Bitmap Sample Window',π LoadMenu (HInstance, 'MAINMENU')));πEND;ππVARπ ClipApp : TClipApp;π DC, MemDC : hDC;π Bitmap, OldBitmap : HBitmap;π BM : TBitmap;π Rect : TRect;π H, W : Integer;π Ticks : LongInt;πBEGINπ{ ** !! DISPLAY THe BITMAP BEFOR APPLICATION.INIT !! ** }ππ{ ** Create the display context ** }π DC := CreateDC('DISPLAY',nil,nil,nil);π{ ** Load the bitmap stored in the resource ** }π Bitmap := LoadBitmap(HInstance, MakeIntResource('STARTBITMAP'));π{ ** Memory context compatibel to the display context ** }π MemDC := CreateCompatibleDC(DC);π{ ** Save the actual context ** }π OldBitmap := SelectObject(MemDC, Bitmap);π{ ** Get the bitmap ** }π GetObject (Bitmap, SizeOf(BM),@BM);π{ ** Get height and width of the screen ** }π H := GetSystemMetrics (sm_CyScreen);π W := GetSystemMetrics (sm_CxScreen);π{ ** Copy the resource bitmap into the memory context and move itπ exactly in the middle of the screen !! ** }π BitBlt (DC,W DIV 2-(BM.bmWidth DIV 2), H DIV 2-(BM.bmHeight DIV 2),π BM.bmWidth, BM.bmHeight, MemDC, 0, 0, SRCCopy);π{ ** Holds the system for 5 seconds, to study the bitmap.π 5000 = milliseconds ** }π Ticks := GetTickCount;π Repeatπ Until ABS (Ticks - GetTickCount) > 5000;π{ ** Remove all bitmaps and contexts ** }π DeleteObject (SelectObject (MemDC, OldBitmap));π DeleteDC (MemDC);π DeleteDC (DC);π{ ** Now start the main window ** }π ClipApp.Init('Bitmap Sample Window');π ClipApp.Run;π ClipApp.Done;πEND.ππ----------------------- CUT IT -- CUT IT -----------------------------ππThis example will show the resource bitmap befor the main window,πwithout opening an other window. I made this program as easy asπpossible. The palette is not included, but a 256 colored palette willπbe added (selectpalette - realizepalette) without difficulties.πOfcourse a normal bitmap (HDD) could also be used instead of theπresource bitmapπ 6 08-24-9417:55ALL ANDREW EIGUS Windows Detection SWAG9408 º∞" 4 Kx πFunction RunningUnderMSWindows : boolean; assembler;πAsmπ MOV AX,1600hπ INT 2FhπEnd; { RunningUnderMSWindows }ππorππFunction RunningUnderMSWindows : boolean;πvar Regs : registers;πBeginπ Regs.AX := $1600;π Intr($2F, Regs);π RunningUnderMSWindows := Boolean(Regs.AL)πEnd; { RunningUnderWindows }ππ 7 08-25-9409:06ALL MATTHEW R POWENSKI Pascal WinG Unit SWAG9408 go▄ 19 Kx { From: dv224@cleveland.Freenet.Edu (Matthew R Powenski) }ππUnit WinG;ππInterfaceππUsesπ WinTypes;ππTypeπ pPointer = ^Pointer;π Wing_Dither_Type = (WING_DISPERSED_4x4,π WING_DISPERSED_8x8, WING_CLUSTERED_4x4);ππ{**** WingDC and WinGBitmapπ************************************************}ππ Function WinGCreateDC: HDC;π Function WinGRecommendDIBFormat (pFormat: pBitmapInfo): Bool;π Function WinGCreateBitmap (WinGDC: hDC; pHeader: pBitmapInfo;πppBits: pPointer): hBitmap;π Function WinGGetDIBPointer (WinGBitmap: hBitmap; pHeader:πpBitmapInfo): Pointer;π Function WinGGetDIBColorTable (WinGDC:πhDC;StartIndex,NumberOfEntries: Word; Var Colors: tRgbQuad): Word;π Function WinGSetDIBColorTable (WinGDC:πhDC;StartIndex,NumberOfEntries: Word; Var Colors: tRgbQuad): Word;ππ{**** Halftoningπ***********************************************************}ππ Function WinGCreateHalftonePalette: HPALETTE;π Function WinGCreateHalftoneBrush (Context: HDC;crColor: tColorRef;πDitherType: WING_DITHER_TYPE): hBrush;ππ{**** Bltsπ***************************************************************π**}ππ Function WinGBitBlt (hdcDest:πHDC;nXOriginDest,nYOriginDest,nWidthDest,nHeightDest: Integer;π hdcSrc: HDC;nXOriginSrc,nYOriginSrc: Integer): Bool;ππ Function WinGStretchBlt (hdcDest:πHDC;nXOriginDest,nYOriginDest,nWidthDest,nHeightDest: Integer;π hdcSrc:πHDC;nXOriginSrc,nYOriginSrc,nWidthSrc,nHeightSrc: Integer): Bool;ππImplementationπ Function WinGBitBlt; External 'WING' Index 1010;π Function WinGCreateBitmap; External 'WING' Index 1003;π Function WinGCreateDC; External 'WING' Index 1001;π Function WinGCreateHalftoneBrush; External 'WING' Index 1008;π Function WinGCreateHalftonePalette; External 'WING' Index 1007;π Function WinGGetDIBColorTable; External 'WING' Index 1005;π Function WinGGetDIBPointer; External 'WING' Index 1004;π Function WinGRecommendDIBFormat; External 'WING' Index 1002;π Function WinGSetDIBColorTable; External 'WING' Index 1006;π Function WinGStretchBlt; External 'WING' Index 1009;π End.π 8 08-25-9409:08ALL MICHAEL VINCZE Using lzexpand.dll SWAG9408 ╗q 8 Kx {πFrom: mav@dseg.ti.com (Michael Vincze)ππ>Does anyone know how to use the decompression toolπ>incorporated into MS-Windows (lzexpand.dll) in BP7?ππHere's an example. Note that you can only do decompression and notπcompression :^(π}π function CopyLZ (FileIn, FileOut: PChar): LongInt;π varπ HandleIn : Integer;π HandleOut : Integer;π StructIn : TOFStruct;π StructOut : TOFStruct;π ReturnCode: LongInt;π beginπ HandleIn := LZOpenFile (FileIn, StructIn, OF_READ);π ReturnCode := LongInt (HandleIn);π if (HandleIn > -1) thenπ beginπ HandleOut := LZOpenFile (FileOut, StructOut, OF_CREATE or OF_WRITE);π ReturnCode := LongInt (HandleOut);π if (HandleOut > -1) thenπ beginπ ReturnCode := LZCopy (HandleIn, HandleOut);π LZClose (HandleOut);π end;π end;π LZClose (HandleIn);π CopyLZ := ReturnCode;π end;π 9 08-25-9409:10ALL MICHAEL VINCZE OWL Owner-Drawn List BoxeSWAG9408 └$⌡ 63 Kx {πFrom: mav@dseg.ti.com (Michael Vincze)ππ>I am trying to put together an owner drawn list box that has it's ownπ>strings. (i.e. Style := Style AND NOT lbs_HasStrings) Windows never callsπ>my DrawItem method. I think it may have something to do with the factπ>that I do not know how to tell windows how many items there are in theπ>list box. (Maybe it thinks there are none... *shrug*)π>π>If anyone has had this problem, or has knows where I can get sourceπ>examples of owner-drawn list boxes that have their own strings, pleaseπ>let me know.ππIncluded is an example of an owner drawn list box. The example is inπtwo parts: "ownlist.pas", and "ownlist.res". The resource file hasπbeen translated with uuencode.ππ{ Author: Michael Vincze 12/27/93 }π{ }π{ Purpose: Shows how to create an owner drawn list box. }π{ }π{ Usage: Simply run. }ππprogram OwnListBox;ππusesπ WinCrt,π BWCC,π Strings,π WinTypes,π WinProcs,π Objects,π OWindows,π ODialogs;ππ{$R OwnList}ππconstπ ApplicationName: PChar = 'Owner Draw List Box';ππ wListBoxId = 200; { ID of OwnerDrawn ListBox Control }π wNumItems = 12; { Number of items added to ListBox }ππtypeππ PODListBox = ^TODListBox;π TODListBox = object (TListBox)π hIcon1, hIcon2: HICON;π constructor InitResource (AParent: PWindowsObject; ResourceID: Integer);π destructor Done; virtual;π procedure ODADrawEntire (DrawItemStruct: PDrawItemStruct);π procedure ODAFocus (DrawItemStruct: PDrawItemStruct);π procedure ODASelect (DrawItemStruct: PDrawItemStruct);π procedure DrawEntry (DrawItemStruct: PDrawItemStruct);π procedure DrawSelf (DrawItemStruct: PDrawItemStruct);π end;ππ TTemplateApplication = object (TApplication)π procedure InitMainWindow; virtual;π end;ππ PTemplateWindow = ^TTemplateWindow;π TTemplateWindow = object (TDlgWindow)π AnOwnListBox: PODListBox;π constructor Init (AParent: PWindowsObject; ATitle: PChar);π procedure SetupWindow; virtual;π function GetClassName : PChar; virtual;π destructor Done; virtual;π procedure WMMeasureItem (var Msg: TMessage); virtual wm_First +πwm_MeasureItem;π procedure WMDrawItem (var Msg: TMessage); virtual wm_First +πwm_DrawItem;π end;ππconstructor TODListBox.InitResource (AParent: PWindowsObject; ResourceID:πInteger);πbeginπinherited InitResource (AParent, ResourceId);πhIcon1 := LoadIcon (0, idi_Exclamation);π{πhIcon2 := LoadIcon (0, idi_Question);π}πhIcon2 := LoadIcon (hInstance, 'icon_1')πend;ππdestructor TODListBox.Done;πbeginπinherited Done;πDestroyIcon (hIcon2);πend;ππprocedure TODListBox.ODADrawEntire (DrawItemStruct: PDrawItemStruct);πbeginπDrawEntry (DrawItemStruct);πif (DrawItemStruct^.itemState and ods_Focus) <> 0 thenπ DrawFocusRect (DrawItemStruct^.hDC, DrawItemStruct^.rcItem);πend;ππprocedure TODListBox.ODAFocus (DrawItemStruct: PDrawItemStruct);πbeginπDrawFocusRect (DrawItemStruct^.hDC, DrawItemStruct^.rcItem);πend;ππprocedure TODListBox.ODASelect (DrawItemStruct: PDrawItemStruct);πbeginπDrawEntry (DrawItemStruct);πif (DrawItemStruct^.itemState and ods_focus) <> 0 thenπ DrawFocusRect (DrawItemStruct^.hDC, DrawItemStruct^.rcItem);πend;ππprocedure TODListBox.DrawSelf (DrawItemStruct: PDrawItemStruct);πbeginπwith DrawItemStruct^ doπ beginπ if (itemAction and oda_DrawEntire) <> 0 thenπ ODADrawEntire (DrawItemStruct)π else if (itemAction and oda_Focus) <> 0 thenπ ODAFocus (DrawItemStruct)π else if (itemAction and oda_Select) <> 0 thenπ ODASelect (DrawItemStruct)π end;πend;ππprocedure TODListBox.DrawEntry (DrawItemStruct: PDrawItemStruct);πvarπ dwColor : Word;π szString: array [0..100] of Char;π TextRect: TRect;π bkColor : LongInt;πbeginπwvsprintf (szString, 'This is ListBox Entry %d', DrawItemStruct^.itemID );πdwColor := GetTextColor (DrawItemStruct^.hDC);πCopyRect (TextRect, DrawItemStruct^.rcItem);πInc (TextRect.Left, 50);ππ{πShould create a logbrush that is the background and then fillπif in appropriately.ππFillRect (DrawItemStruct^.hDC, DrawItemStruct^.rcItem, GetStockObjectπ(gray_brush));π}πif (DrawItemStruct^.itemState and ODS_SELECTED) <> 0 thenπ beginπ SetTextColor (DrawItemStruct^.hDC, RGB ($ff,0,0));π if (hIcon1) <> 0 thenπ DrawIcon (DrawItemStruct^.hDC,π DrawItemStruct^.rcItem.left+10,π DrawItemStruct^.rcItem.top,π hIcon1);π endπelseπ beginπ if (hIcon2) <> 0 thenπ DrawIcon (DrawItemStruct^.hDC,π DrawItemStruct^.rcItem.left+10,π DrawItemStruct^.rcItem.top,π hIcon2);π end;πDrawText (DrawItemStruct^.hDC,π szString,π StrLen (szString),π TextRect,π DT_SINGLELINE or DT_VCENTER or DT_LEFT);ππSetTextColor (DrawItemStruct^.hDC, dwColor);πend;πππππππprocedure TTemplateApplication.InitMainWindow;πbeginπMainWindow := New (PTemplateWindow, Init (nil, 'MainDialog'));πend;ππconstructor TTemplateWindow.Init (AParent: PWindowsObject; ATitle: PChar);πbeginπinherited Init (AParent, ATitle);πAnOwnListBox := New (PODListBox, InitResource (@Self, wListBoxId));πend;ππfunction TTemplateWindow.GetClassName;πbegin GetClassName := 'BorDlg' end;ππdestructor TTemplateWindow.Done;πbeginπinherited Done;πend;ππprocedure TTemplateWindow.SetupWindow;πvarπ I: Word;πbeginπinherited SetupWindow;πfor I :=0 to wNumItems - 1 doπ AnOwnListBox^.AddString (MAKEINTRESOURCE( i ));πend;ππprocedure TTemplateWindow.WMMeasureItem (var Msg: TMessage);πvarπ lpMeasureItem: PMEASUREITEMSTRUCT;πbeginπlpMeasureItem := PMEASUREITEMSTRUCT (Msg.LParam);ππif (lpMeasureItem^.CtlType = ODT_LISTBOX) and (lpMeasureItem^.CtlID =πwListBoxId) thenπ lpMeasureItem^.itemHeight := GetSystemMetrics (SM_CYICON)πelseπ DefWndProc (Msg);πend;ππprocedure TTemplateWindow.WMDrawItem (var Msg: TMessage);πbeginπif (PDrawItemStruct (Msg.lParam)^.CtlId) = wListBoxId thenπ AnOwnListBox^.DrawSelf (PDrawItemStruct (Msg.lParam));πMsg.Result := 1;πend;ππvarπ Application:TTemplateApplication;ππbeginπApplication.Init (ApplicationName);πApplication.Run;πApplication.Done;πend.ππ{---------- snip ---------- snip ---------- snip ---------- snip ----------}ππbegin 644 ownlist.resπM_P, _P$ ,!#H @ * " ! 0 $ " @ πM ( ( " @ " @ " (" " @( P,# πM_P _P /__ /\ #_ /\ __\ /___P πM N[N[NP +N[N[N[N[L +N[N[N[N[N[NP πM N[N[N[N[N[N[NP "[N[N[N[N[N[N[NP +N[N[N[N[N[N[N[πMNP N[N[N[N[N[N[N[N[NP +N[N[N[N[N[N[N[N[L N[N[N[N[N[N[πMN[N[N[L +N[N[N[N[N[N[N[N[N[ "[N[N[N[N[N[N[N[N[NP + +N[N[πMN[N[N[N[N[NP +N[L+N[N[N[N[N[N[N[L "[N[L+NPNPNPNP"P L+ N[N[πM"[L NPL+L+L+N["P +N[NP"["P L+L+ N[ "[N[L "PNPNP +"P"PL +πM"[N[ + +L+L L N[ +L "P"[NP"[N[N[N[N[N[N[L "[ +N[N[N[N[N[N[πMNP N[N[N[N[N[N[N[N[N[L +N[N[N[N[N[N[N[N[N[ +N[N[N[N[N[N[πMN[N[L "[N[N[N[N[N[N[N[N[ "[N[N[N[N[N[N[N[L "[N[N[N[πMN[N[N[NP "[N[N[N[N[N[N[ "[N[N[N[N[N[L +πMN[N[N[N[L "[N[N[ /_PπM#___@ '__@ ?_P #_X ?\ #^ ? #P X & !@πM 0 @ 8 & !πMP \ /@ '\ #_@ !_\ __@ ?_^ ?__\ ___P4 34%)3D1)πM04Q/1P P$*X ,B !1( $@#: (( &)O<F1L9P!/=VYE<B!$<F%W;B!,πM:7-T0F]X %T 9@ @ !0 0 -00F]R0G1N $)U='1O;@ $0 0 +@ " #_πM_P E""3W=N97(@1')A=VX@)DQI<W1B;W@ !( &@"X #8 R "1 *%0@P πM !< -H @!F ( %!";W)3:&%D90 D "P#( $D 9P ! !00F]R4VAAπM9&4 #_#@!)0T].7S$ ,! 4 ! $ (" 0 0 0#H @ 0#_#P#_πM 0 P'# . X 8 24-/3E\Q !( !0 !@ !-04E.1$E!3$]' π+ π πendππ{---------- end ---------- end ---------- end ---------- end ----------}π 10 08-25-9409:12ALL ZWEITZE DE VRIES Using VER.DLL SWAG9408 U▐( 16 Kx {πFrom: ZWEITZE@et.tudelft.nl (Zweitze de Vries)ππ>Does anyone have examples of installation programs that useπ>the file installation library (VER.DLL) in BP7?ππSince all installation programs do the same thing, why reinventπthe wheel? Just buy one, it should be cheaper than developingπyour own. There are also some share/freeware apps around (try CICA).ππIn respect to your question, I have some code that fills a dialogπbox ('About...') according to the version information resource:π}ππprocedure THelpAbout.SetUpWindow;πvarπ lVerInfoSize: LongInt;π lVerHandle: LongInt;π szModuleName: array [0..fsPathName] of Char;π pVerData: PChar;π Buffer: Pointer;π lenBuffer: Word;πbeginπ TDialog.SetupWindow;π GetModuleFileName(hInstance, szModuleName, SizeOf(szModuleName));π lVerInfoSize := GetFileVersionInfoSize(szModuleName, lVerHandle);π if lVerInfoSize = 0 then Exit;π GetMem(pVerData, lVerInfoSize);π if not GetFileVersionInfo(szModuleName, lVerHandle, lVerInfoSize, pVerData)π then Exit;π if VerQueryValue(pVerData, '\StringFileInfo\CATE\ProductName',π Buffer, LenBuffer)π and (LenBuffer <> 0)π then SetDlgItemText(hWindow, stat_AppName, Buffer);π if VerQueryValue(pVerData, '\StringFileInfo\CATE\ProductVersion',π Buffer, LenBuffer)π and (LenBuffer <> 0)π then SetDlgItemText(hWindow, stat_AppVersion, Buffer);π if VerQueryValue(pVerData, '\StringFileInfo\CATE\CompanyName',π Buffer, LenBuffer)π and (LenBuffer <> 0)π then SetDlgItemText(hWindow, stat_AppCompany, Buffer);π if VerQueryValue(pVerData, '\StringFileInfo\CATE\LegalCopyright',π Buffer, LenBuffer)π and (LenBuffer <> 0)π then SetDlgItemText(hWindow, stat_AppCopyright, Buffer);π FreeMem(pVerData, lVerInfoSize);πend;π 11 08-25-9409:12ALL BRIAN GRAINGER Bitmap Loading In WindowsSWAG9408 ≈ù$0 16 Kx {πMM> Thanks alot but I was woundering if you had the complete code USESπMM> and every thing no blanks. Becuase I am not to good at graphics. ---ππ}πUNIT BMPWin;ππINTERFACEππUSESπ WinProcs, WinTypes, Objects, OWindows;ππ{$R MYBMP.RES} (* Change as appropriate *)ππTYPEπ pBMPWindow = ^tBMPWindow;π tBMPWindow = OBJECT(tWindow)π PRIVATEπ vBitmap : hBitmap;π vBitSize : tBitmap;π PUBLICπ CONSTRUCTOR Init(aParent : pWindowsObject; aBitmapName : pChar);π DESTRUCTOR Done; VIRTUAL;π PROCEDURE SetupWindow; VIRTUAL;π PROCEDURE Paint(vDC : hDC; VAR vPS : tPaintStruct); VIRTUAL;π END;ππIMPLEMENTATIONππCONSTRUCTOR tBMPWindow.Init(aParent : pWindowsObject; aBitmapName :πpChar);π BEGINπ INHERITED Init(aParent, NIL);π Attr.Style := ws_Child OR ws_Visible;π vBitmap := LoadBitmap(hInstance, aBitmapName);π IF vBitmap = 0 THENπ BEGINπ Status := em_InvalidWindow;π Fail;π END;π GetObject(vBitmap, SizeOf(vBitSize), @vBitSize);π END;ππDESTRUCTOR tBMPWindow.Done;π BEGINπ DeleteObject(vBitmap);π INHERITED Done;π END;ππPROCEDURE tBMPWindow.SetupWindow;π BEGINπ INHERITED SetupWindow;π SetWindowPos(hWindow, 0, 0, 0, vBitSize.bmWidth, vBitSize.bmHeight,π swp_NoMove OR swp_NoZOrder OR swp_NoActivate ORπ swp_NoRedraw);π END;ππPROCEDURE tBMPWindow.Paint(vDC : hDC; VAR vPS : tPaintStruct);π VARπ vRect : tRect;ππ PROCEDURE DrawBitmap;π VARπ vMemDC : hDC;π vOldBMP : hBitmap;ππ BEGINπ vMemDC := CreateCompatibleDC(vDC);π vOldBMP := SelectObject(vMemDC, vBitmap);π BitBlt(vDC, 0, 0, Attr.W, Attr.H, vMemDC, 0, 0, srcCopy);π SelectObject(vMemDC, vOldBMP);π DeleteDC(vMemDC);π END;ππ BEGINπ SaveDC(vDC);π DrawBitmap;π RestoreDC(vDC, -1);π END;πEND.π 12 08-25-9409:12ALL PETER GRUHN Offscreen Bitmaps-WindowsSWAG9408 ¼9ë 20 Kx {πFrom: peter.gruhn@delta.com (Peter Gruhn)ππ Ka> I've had little luck in finding out how to do more general drawing inπ Ka> an offscreen bitmap (say, with a compatible bitmap created from anπ Ka> HWindow's DC).ππI'm assuming you have a DC already off screen that you can blit from?πYou can draw to it too. Just like a normal DC. I'm worrying now that Iπdon't quite understand either your problem or just what your code looksπlike.ππ Ka> Many thanks for your help.ππHey, it's late, I'll see what I can write...there didn't take long. Iπwas able to draw rectangles off screen and blit them to the main window.πYou ought to be able to do whatever drawing function you want. I tookπsome short cuts regarding colour depth and bitmap size (hard codingπrules OK!)ππby Peter Gruhnπ it's small and useless and stupid and somebodyπ might find it useful, so I release this programπ into the public domain for the good of allπ sentient species the universe over. 7-8-1994π}ππprogram offscree;ππ{you have tpw not bp? your uses will be a little different}πuses owindows,winprocs,wintypes;ππtypeπ TMyApp=object(tapplication)π procedure initmainwindow; virtual;π end;ππ PMyWin=^TMyWin;π TMyWin=object(TWindow)π procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;π end;ππprocedure TMyApp.initmainwindow;πbeginπ mainwindow:=new(pmywin,init(nil,'Try this...'));πend;ππprocedure TMyWin.Paint;πvar adc:hdc;π abmp:hbitmap;π i:integer;π s:string;πbeginπ{Create stuff}π adc:=createcompatibledc(paintdc);π {I believe that I am cheating here, by just divving number of bitsπ by 2 as I happen to know that right now I am in 16 colour mode.π You will forgive me.}π abmp:=createcompatiblebitmap(paintdc,300 div 2,300 div 2);π abmp:=selectobject(adc,abmp);ππ{Blank off screen bitmap of random data}π bitblt(adc,0,0,300,300,adc,0,0,whiteness);ππ{Draw something}π for i:=0 to 1024 doπ beginπ rectangle(adc,random(300),random(300),random(300),random(300));π str(i:5,s); {textify i for...}π s[6]:=#0; {null terminator}π textout(paintdc,10,10,@(s[1]),byte(s[0])); {just to count so it don't lookπplain}π end;ππ{blit it to the window}π bitblt(paintdc,10,10,300,300,adc,0,0,srccopy);ππ{Kill stuff}π deleteobject(selectobject(adc,abmp));π deletedc(adc);πend;ππvar app:TMyApp;ππbeginπ app.init('frog');π app.run;π app.done;πend.π 13 08-25-9409:13ALL WIM VAN DER VEGT Windows Delay SWAG9408 WΓj 8 Kx {πHere a small BPW source which implements a Delay(ms : Word); just likeπin the DOS version. Limitations are that only a minimum delay isπguaranteed, so timing is not exact. This is due to the task switchingπnature of windows which makes it impossible to generate accurate delays.πFor large values it's however quite good.ππThe timer used has msec accuracy and has overflow every 49 days (ifπwindows lasts that long in one session.π}ππUsesπ Winprocs;ππProcedure Delay(ms : Word);ππVarπ theend,π marker : Longint;ππBeginπ{----Potential overflow if windows runs for 49 days without a stop}π marker:=GetTickCount;π{$R-}π theend:=Longint(marker+ms);π{$R+}π{----First see if timer overrun will occur and wait for it. Then test asπusual}π If (theend<marker)π Then While (GetTickCount>=0) DO;π While (theend>GettickCount) Do;πEnd; {of Delay}π 14 08-25-9409:13ALL PETER GRUHN Windows Shell! SWAG9408 u╡óU 18 Kx {πFrom: peter.gruhn@delta.com (Peter Gruhn)ππ Ba> What I want to know is, can some-one post a sample of source codeπ Ba> that would provide a 'beginners shell' for windows programming. I.e.ππHow about if I post this test code that somebody wanted a few days ago.πIt has no interaction and doesn't bother to make use of the timer orπanything in the draw loop, but it's a quick draw loop. You can set upπtimers and i/o responses as you see fit. Right off though, just having aπwindow to draw in is a good start. It's how I started...ππby Peter Gruhnπ it's small and useless and stupid and somebodyπ might find it useful, so I release this programπ into the public domain for the good of allπ sentient species the universe over. 7-8-1994}ππprogram offscree;ππuses owindows,winprocs,wintypes;ππtypeπ TMyApp=object(tapplication)π procedure initmainwindow; virtual;π end;ππ PMyWin=^TMyWin;π TMyWin=object(TWindow)π procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;π end;ππprocedure TMyApp.initmainwindow;πbeginπ mainwindow:=new(pmywin,init(nil,'Try this...'));πend;ππprocedure TMyWin.Paint;πvar adc:hdc;π abmp:hbitmap;π i:integer;π s:string;πbeginπ{Create stuff}π adc:=createcompatibledc(paintdc);π {I believe that I am cheating here, by just divving number of bitsπ by 2 as I happen to know that right now I am in 16 colour mode.π You will forgive me.}π abmp:=createcompatiblebitmap(paintdc,300 div 2,300 div 2);π abmp:=selectobject(adc,abmp);ππ{Blank off screen bitmap of random data}π bitblt(adc,0,0,300,300,adc,0,0,whiteness);ππ{Draw something}π for i:=0 to 1024 doπ beginπ rectangle(adc,random(300),random(300),random(300),random(300));π str(i:5,s); {textify i for...}π s[6]:=#0; {null terminator}π textout(paintdc,10,10,@(s[1]),byte(s[0])); {just to count so it don't lookπplain}π end;ππ{blit it to the window}π bitblt(paintdc,10,10,300,300,adc,0,0,srccopy);ππ{Kill stuff}π deleteobject(selectobject(adc,abmp));π deletedc(adc);πend;ππvar app:TMyApp;ππbeginπ app.init('frog');π app.run;π app.done;πend.π 15 08-25-9409:13ALL MICHAEL A VINCZE Windows File Manager ExteSWAG9408 ñε╩ 182 Kx {πFrom: vincze@dseg.ti.com (MICHAEL A VINCZE 0171847)ππWell after posting the question about how to create a WindowsπFile Manager extension and not getting any responses, I figuredπthat not a lot of people know how to do. So after several hours,πas typical with translating something from C to Pascal, I finallyπgot the following example to work. Note that the example consistsπof four files:ππ constant.pasπ xtension.pasπ xtension.rcπ icon.zip <- this is uuencoded here.ππJust FYI one of the hardest items to figure out was the parameter infoπfor the FMExtensionProc function. The Borland supplied WFEXT.PAS fileπis totally bogus. The key was to pass lParam by reference, and notπby value. Hence the following:ππ function FMExtensionProc (Handle: HWnd; Msg: WORD; var lParam: Longint):π HMENU; export; ^^^ππEvidently, the File Manager allocates space for a TFMS_LOAD structure (record)πand passes the address to this structure via the lParam parameter. This shouldπlead you to a rule of thumb for translating Windows C programs to Pascal.πI leave the wording for the rule of thumb up to yourself to figure out.ππBest regards,πMichael Vinczeπmav@asd470.dseg.ti.comππ---------- snip ---------- snip ---------- snip ----------ππunit constant;ππinterfaceππconstππ { menu items (must within the range of 1 to 99π }π IDM_STATUSWIN = 10;π IDM_GETFILESELLFN = 15;π IDM_GETDRIVEINFO = 20;π IDM_GETFOCUS = 25;π IDM_RELOADEXTENSIONS = 30;π IDM_REFRESHWINDOW = 35;π IDM_REFRESHALLWINDOWS = 40;π IDM_ABOUTEXT = 45;πππ { dialog itemsπ }π IDD_PATH = 206;π IDD_VOLUME = 207;π IDD_SHARE = 208;π IDD_TOTALSPACE = 209;π IDD_FREESPACE = 210;ππ IDD_SELFILECOUNT = 201;π IDD_SELFILESIZE = 202;πππ { miscellaneous itemsπ }π STATUS_WIDTH = 400;π STATUS_HEIGHT = 100;π INFO_LINE_WIDTH = 300;π INFO_LINE_HEIGHT = 18;π INFO_LINE_X = 10;π INFO_LINE_Y = 20;π ID_STATUSTIMER = 99;π INFO_STR_LEN = 50;π TIMER_DURATION = 1500; { 1.5 seconds }π PATH_NAME_LEN = 260;π VOLUME_NAME_LEN = 14;π SHARE_NAME_LEN = 128;π SMALL_STR_LEN = 12;π LONG_STR_LEN = 60;ππimplementationππend.ππ---------- snip ---------- snip ---------- snip ----------ππlibrary XTension;ππ{ Author: Michael Vincze 07/30/94 }π{ vincze@lobby.ti.com }π{ mav@asd470.dseg.ti.com }π{ }π{ The following File Manager extension is a translation from C. }π{ The C code was taken from the Microsoft Product Support }π{ Services, and obtained from the anonymous FTP site }π{ ftp.microsoft.com with a file name of 4-23.zip. The main }π{ preamble of the original source has been preserved below. }ππ(*π//***************************************************************************π//π// Library:π// XTENSION.DLLπ//π//π// Author:π// Microsoft Product Support Services.π//π//π// Purpose:π// XTENSION is a File Manager extension DLL. An extension DLL addsπ// a menu to File Manager, contains entry point that processes menuπ// commands and notification messages sent by File Manager, andπ// queries data and information about the File Manager windows. Theπ// purpose of an extension DLL is to add administration supportπ// features to File Manager, for example, file and disk utilities.π// Up to five extension DLLs may be instaled at any one time.π//π// XTENSION adds a menu called "Extension" to File manager andπ// processes all the messages that are sent by File Manager to anπ// extension DLL. In order to retrieve any information, it sendsπ// messages to File Manager. It also creates a topmost status windowπ// using the DLL's instance handle.π//π//π// Usage:π// File Manager installs the extensions that have entries in theπ// [AddOns] section of the WINFILE.INI initialization file. An entryπ// consists of a tag and a value. To load XTENSION.DLL as a Fileπ// Manager extension, add the following to WINFILE.INI (assuming theπ// DLL resides in c:\win\system):π//π// [AddOns]π// SDK Demo Extension=c:\win\system\xtension.dllπ//π//π// Menu Options:π// Following menu items belong to the "Extension" menu that is addedπ// to File Manager:π//π// Status Window - Shows/Hides status windowπ// Selected File(s) Size... - Displays disk space taken by the filesπ// Selected Drive Info... - Displays selected drive informationπ// Focused Item Info - Displays the name of the focused itemπ// Reload Extension - Reloads this extensionπ// Refresh Window - Refreshes File Manager's active windowπ// Refresh All Windows - Refreshes all the File Manager's windowsπ// About Extension... - Displays About dialogπ//π//π// More Info:π// Query on-line help on: FMExtensionProc, File Manager Extensionsπ//π//π// COPYRIGHT:π//π// (C) Copyright Microsoft Corp. 1993. All rights reserved.π//π// You have a royalty-free right to use, modify, reproduce andπ// distribute the Sample Files (and/or any modified version) inπ// any way you find useful, provided that you agree thatπ// Microsoft has no warranty obligations or liability for anyπ// Sample Application Files which are modified.π//π//***************************************************************************π*)ππππ{$D File Manager Extension DLL}ππ{$R XTENSION}ππusesπ WinTypes,π WinProcs,π Win31,π WFExt,π Constant;ππconstπ gszDllWndClass : PChar = 'ExtenStatusWClass'; { Class name for statusπwindow }π ghwndStatus : HWND = 0; { Status window π }π ghwndInfo : HWND = 0; { Child window of statusπwindow }π ghDllInst : THANDLE = 0; { DLL's instance handle π }π ghMenu : HMENU = 0; { Extension's menu handleπ }π gwMenuDelta : WORD = 0; { Delta for extension'sπmenu items }π gbStatusWinVisible: BOOLEAN = FALSE; { Flag for status window π }π { FALSE=Hidden, πTRUE=Visible }ππ{ type to handle passing Longint types to wvsprintfπ}πtypeπ TLongRec = recordπ LO: WORD;π HI: WORD;π end;ππprocedure DisplayStatus (Handle: HWND; wEvent: Longint);πvarπ wFileCount: Longint;π szInfo : array [0..INFO_STR_LEN] of CHAR;π lFileCount: TLongRec;πbeginπif gbStatusWinVisible = TRUE thenπ beginπ case wEvent ofππ FMEVENT_INITMENU:π SetWindowText (ghwndInfo, 'Extension menu selected...');ππ FMEVENT_SELCHANGE:π beginπ wFileCount := SendMessage (Handle, FM_GETSELCOUNTLFN, 0, 0);π lFileCount.LO := LOWORD (wFileCount);π lFileCount.HI := HIWORD (wFileCount);π wvsprintf (szInfo, 'File selection changed: %ld item(s) selected...',πlFileCount);π SetWindowText (ghwndInfo, szInfo);π end;ππ FMEVENT_UNLOAD:π SetWindowText (ghwndInfo, 'Unloading extension...');ππ FMEVENT_USER_REFRESH:π SetWindowText (ghwndInfo, 'Refreshing window(s)...');ππ end;ππ { Timer to erase the info after the elapsed timeπ }π SetTimer (ghwndStatus, ID_STATUSTIMER, TIMER_DURATION, nil);π end;πend;ππππfunction StatusWndProc (hWin: HWND; uMessage: WORD; wParam: WORD; lParam:πLongint): Longint; export;πbeginπcase uMessage ofππ WM_TIMER:π { This timer is used to erase info from theπ status window at the elapsed timeπ }π if wParam = ID_STATUSTIMER thenπ beginπ KillTimer (hWin, wParam);π SetWindowText (ghwndInfo, '');π end;ππ elseπ beginπ StatusWndProc := DefWindowProc (hWin, uMessage, wParam, lParam);π exit;π end;ππ end;ππStatusWndProc := 0;πend;ππππππππfunction CreateStatusWindow (hwndExtension: HWND): BOOLEAN;πvarπ wc: TWNDCLASS;πbeginπwc.style := 0;πwc.lpfnWndProc := @StatusWndProc;πwc.cbClsExtra := 0;πwc.cbWndExtra := 0;πwc.hInstance := ghDllInst;πwc.hIcon := LoadIcon (0, IDI_APPLICATION);πwc.hCursor := LoadCursor (0, IDC_ARROW);πwc.hbrBackground := COLOR_WINDOW + 1;πwc.lpszMenuName := nil;πwc.lpszClassName := gszDllWndClass;ππif not RegisterClass (wc) thenπ beginπ CreateStatusWindow := FALSE;π exit;π end;ππghwndStatus := CreateWindowEx (WS_EX_TOPMOST or WS_EX_DLGMODALFRAME,π gszDllWndClass,π 'File Manager Extension',π WS_POPUP or WS_CAPTION,π CW_USEDEFAULT,π CW_USEDEFAULT,π STATUS_WIDTH,π STATUS_HEIGHT,π hwndExtension,π 0,π ghDllInst,π nil);ππghwndInfo := CreateWindow ('STATIC',π nil,π WS_CHILD or WS_VISIBLE,π INFO_LINE_X,π INFO_LINE_Y,π INFO_LINE_WIDTH,π INFO_LINE_HEIGHT,π ghwndStatus,π 1,π ghDllInst,π nil);ππ{ note I changed the logic from the original code below to return TRUE iff bothπ windows got created.π}πCreateStatusWindow := (ghwndStatus <> 0) and (ghwndInfo <> 0);πend;πππππfunction DriveInfoDlgProc (hDlg: HWND; uMessage: WORD; wParam: WORD; lParam:πLongint): BOOLEAN; export;πvarπ fmsDriveInfo: TFMS_GETDRIVEINFO;π szTempString: array [0..SMALL_STR_LEN] of Char;π lTotalSpace : TLongRec;π lFreeSpace : TLongRec;πbeginππ·π(continued next message)ππ─ Area: U-PASCAL |61 ────────────────────────────────────────────────────π Msg#: 6684 Date: 08-04-94 07:28π From: Vincze@dseg.ti.com Read: Yes Replied: No π To: All Mark: π Subj: [A] Windows File Managerπ──────────────────────────────────────────────────────────────────────────────π@SUBJECT:[A] Windows File Manager Extension π·(Continued from last message)πcase uMessage ofππ WM_INITDIALOG:ππ beginπ SendMessage (lParam, FM_GETDRIVEINFO, 0, Longint (PFMS_GETDRIVEINFOπ(@fmsDriveInfo)));ππ { Convert OEM characters to Windows charactersπ }π OemToAnsi (fmsDriveInfo.szPath, fmsDriveInfo.szPath);π OemToAnsi (fmsDriveInfo.szVolume, fmsDriveInfo.szVolume);ππ if fmsDriveInfo.szShare[0] <> #0 thenπ OemToAnsi (fmsDriveInfo.szShare, fmsDriveInfo.szShare)π elseπ lstrcpy (fmsDriveInfo.szShare, '< Not a Share >');ππ if fmsDriveInfo.szVolume[0] <> #0 thenπ SetDlgItemText (hDlg, IDD_VOLUME, fmsDriveInfo.szVolume)π elseπ SetDlgItemText (hDlg, IDD_VOLUME, '< No volume label >');ππ SetDlgItemText (hDlg, IDD_PATH, fmsDriveInfo.szPath);π SetDlgItemText (hDlg, IDD_SHARE, fmsDriveInfo.szShare);πππ { When a -1 is returned for either dwTotalSpace or dwFreeSpace,π the extension will have compute that number on its own.π }π if fmsDriveInfo.dwTotalSpace = -1 thenπ SetDlgItemText (hDlg, IDD_TOTALSPACE, '< Info. not available >')π elseπ beginπ lTotalSpace.LO := LOWORD (fmsDriveInfo.dwTotalSpace);π lTotalSpace.HI := HIWORD (fmsDriveInfo.dwTotalSpace);π wvsprintf (szTempString, '%ld', lTotalSpace);π SetDlgItemText (hDlg, IDD_TOTALSPACE, szTempString);π end;ππ if fmsDriveInfo.dwFreeSpace = -1 thenπ SetDlgItemText (hDlg, IDD_FREESPACE, '< Info. not available >')π elseπ beginπ lFreeSpace.LO := LOWORD (fmsDriveInfo.dwFreeSpace);π lFreeSpace.HI := HIWORD (fmsDriveInfo.dwFreeSpace);π wvsprintf (szTempString, '%ld', lFreeSpace);π SetDlgItemText (hDlg, IDD_FREESPACE, szTempString);π end;ππ DriveInfoDlgProc := TRUE;π exit;π end;ππ WM_COMMAND:ππ case wParam ofππ IDOK,π IDCANCEL:π beginπ EndDialog (hDlg, 1);π DriveInfoDlgProc := TRUE;π exit;π end;ππ end;ππ end;ππDriveInfoDlgProc := FALSE;πend;ππππππfunction SelFileInfoDlgProc (hDlg: HWND; uMessage: WORD; wParam: WORD; lParam:πLongint): BOOLEAN; export;πconstπ fmsFileInfo : TFMS_GETFILESEL = (wTime: 0);πvarπ wSelFileCount: WORD;π lSelFileCount: TLongRec;π wIndex : WORD;π szTempString : array [0..SMALL_STR_LEN] of Char;π dwTotalSize : Longint;π lTotalSize : TLongRec;πbeginπcase uMessage ofππ WM_INITDIALOG:π beginπ wSelFileCount := SendMessage (lParam, FM_GETSELCOUNTLFN, 0, 0);π lSelFileCount.LO := LOWORD (wSelFileCount);π lSelFileCount.HI := HIWORD (wSelFileCount);π wvsprintf (szTempString, '%ld', lSelFileCount);π SetDlgItemText (hDlg, IDD_SELFILECOUNT, szTempString);π dwTotalSize := 0;π if wSelFileCount > 0 thenπ for wIndex := 0 to wSelFileCount -1 doπ beginπ SendMessage (HWND (lParam), FM_GETFILESELLFN, wIndex, Longintπ(PFMS_GETFILESEL (@fmsFileInfo)));π Inc (dwTotalSize, fmsFileInfo.dwSize);π end;π lTotalSize.LO := LOWORD (dwTotalSize);π lTotalSize.HI := HIWORD (dwTotalSize);π wvsprintf (szTempString, '%ld bytes', lTotalSize);π SetDlgItemText (hDlg, IDD_SELFILESIZE, szTempString);π SelFileInfoDlgProc := TRUE;π exit;π end;ππ WM_COMMAND:π case wParam ofππ IDOK,π IDCANCEL:π beginπ EndDialog (hDlg, 1);π SelFileInfoDlgProc := TRUE;π exit;π end;ππ end;ππ end;πSelFileInfoDlgProc := FALSE;πend;πππππfunction AboutDlgProc (hDlg: HWND; uMessage: WORD; wParam: WORD; lParam:πLongint): BOOLEAN; export;πbeginπcase uMessage ofππ WM_INITDIALOG:π beginπ AboutDlgProc := TRUE;π exit;π end;ππ WM_COMMAND:π case wParam ofππ IDOK,π IDCANCEL:π beginπ EndDialog (hDlg, 1);π AboutDlgProc := TRUE;π exit;π end;ππ end;ππ end;πAboutDlgProc := FALSE;πend;ππππfunction FMExtensionProc (Handle: HWnd; Msg: WORD; var lParam: Longint): HMENU;πexport;πvarπ lpload : PFMS_LOAD;π lpDialogProc: TFARPROC;π wFocusedItem: WORD;πbeginππcase Msg ofππ { ****************** File Manager Eventsπ }ππ FMEVENT_INITMENU:π DisplayStatus (Handle, Msg);ππ FMEVENT_LOAD:π { Create status windowπ }π beginπ if ghwndStatus = 0 thenπ beginπ if not CreateStatusWindow (Handle) thenπ beginπ MessageBox (Handle,π 'Extension not loaded. Status window creation error.',π 'File Manager Extension', MB_OK or MB_ICONASTERISK);ππ { Unloadπ }π end;π end;ππ lpload := @lParam;ππ { Assign the menu handle from the DLL's resourceπ }π ghMenu := LoadMenu (ghDllInst, 'ExtensionMenu');ππ lpload^.Menu := ghMenu;ππ { This is the delta we are being assigned.π }π gwMenuDelta := lpload^.wMenuDelta;ππ { Size of the load structureπ }π lpload^.dwSize := sizeof (TFMS_LOAD);ππ { Assign the popup menu name for this extensionπ }π lstrcpy (lpload^.szMenuName, '&Extension');ππ MessageBox (Handle, 'File Manager Extension will be loaded.',π 'File Manager Extension', MB_OK);ππ { Return that handleπ }ππ FMExtensionProc := ghMenu;π exit;π end;ππ FMEVENT_SELCHANGE:π DisplayStatus (Handle, Msg);ππ FMEVENT_UNLOAD:π beginπ DisplayStatus (Handle, Msg);π MessageBox (Handle, 'File Manager Extension will be unloaded.',π 'File Manager Extension', MB_OK);ππ { Since the status window was created using DLL'sπ instance handle, we will have to destroy it on our own.π }π DestroyWindow (ghwndStatus);π end;ππ FMEVENT_USER_REFRESH:π DisplayStatus (Handle, Msg);πππ { ****************** Extension menu commandsπ }ππ IDM_STATUSWIN:π beginπ if GetMenuState (ghMenu, gwMenuDelta + Msg, MF_BYCOMMAND) and MF_CHECKED >π0 thenπ beginπ gbStatusWinVisible := FALSE;ππ { Hide the status windowπ }π ShowWindow (ghwndStatus, SW_HIDE);ππ { Remove the checkmarkπ }π CheckMenuItem (ghMenu, gwMenuDelta + IDM_STATUSWIN, MF_UNCHECKED orπMF_BYCOMMAND);ππ endπ elseπ beginπ gbStatusWinVisible := TRUE;ππ { Show the status windowπ }π ShowWindow (ghwndStatus, SW_SHOW);ππ { Add the checkmarkπ }π CheckMenuItem (ghMenu, gwMenuDelta + IDM_STATUSWIN, MF_CHECKED orπMF_BYCOMMAND);π end;π end;ππ IDM_GETDRIVEINFO:π beginπ lpDialogProc := @DriveInfoDlgProc;π DialogBoxParam (ghDllInst, 'DriveInfo', Handle, lpDialogProc, Handle);π end;ππ IDM_GETFILESELLFN:π beginπ lpDialogProc := @SelFileInfoDlgProc;π DialogBoxParam (ghDllInst, 'FileInfo', Handle, lpDialogProc, Handle);π end;ππ IDM_GETFOCUS:π beginπ wFocusedItem := SendMessage (Handle, FM_GETFOCUS, 0, 0);ππ case wFocusedItem ofπ FMFOCUS_DIR:π MessageBox (Handle, 'Focus is on the DIRECTORY window.',π 'Focus Information', MB_OK);ππ FMFOCUS_TREE:π MessageBox (Handle, 'Focus is on the TREE window.',π 'Focus Information', MB_OK);ππ FMFOCUS_DRIVES:π MessageBox (Handle, 'Focus is on the DRIVE bar.',π 'Focus Information', MB_OK);ππ FMFOCUS_SEARCH:ππ MessageBox (Handle, 'Focus is on the SEARCH RESULTS window.',π 'Focus Information', MB_OK);ππ end;ππ end;ππ IDM_REFRESHWINDOW,π IDM_REFRESHALLWINDOWS:π { Refresh one or all the windowsπ }π beginπ if Msg = IDM_REFRESHALLWINDOWS thenπ SendMessage (Handle, FM_REFRESH_WINDOWS, 1, 0)π elseπ SendMessage (Handle, FM_REFRESH_WINDOWS, 0, 0);π end;ππ IDM_RELOADEXTENSIONS:π PostMessage (Handle, FM_RELOAD_EXTENSIONS, 0, 0);ππ IDM_ABOUTEXT:π beginπ lpDialogProc := @AboutDlgProc;π DialogBox (ghDllInst, 'AboutExtension', Handle, lpDialogProc);π end;ππ end;ππFMExtensionProc := 0;πend;ππexportsπ FMEXTENSIONPROC;ππbeginπghDllInst := hInstance;πend.πππ·π(continued next message)ππ─ Area: U-PASCAL |61 ────────────────────────────────────────────────────π Msg#: 6685 Date: 08-04-94 07:28π From: Vincze@dseg.ti.com Read: Yes Replied: No π To: All Mark: π Subj: [A] Windows File Managerπ──────────────────────────────────────────────────────────────────────────────π@SUBJECT:[A] Windows File Manager Extension π·(Continued from last message)π---------- snip ---------- snip ---------- snip ----------ππππ#include "constant.pas"ππExtensionIcon ICON xtension.icoπππExtensionMenu MENUπBEGINπ MENUITEM "&Status Window", IDM_STATUSWINπ MENUITEM SEPARATORπ MENUITEM "Selected &File(s) Size...",IDM_GETFILESELLFNπ MENUITEM "Selected &Drive Info...", IDM_GETDRIVEINFOπ MENUITEM "Focused &Item Info...", IDM_GETFOCUSπ MENUITEM SEPARATORπ MENUITEM "Reload &Extension", IDM_RELOADEXTENSIONSπ MENUITEM "&Refresh &Window", IDM_REFRESHWINDOWπ MENUITEM "Refresh All &Windows", IDM_REFRESHALLWINDOWSπ MENUITEM SEPARATORπ MENUITEM "&About Extension...", IDM_ABOUTEXTπENDππFileInfo DIALOG 22, 17, 144, 71πSTYLE DS_MODALFRAME | WS_OVERLAPPED | WS_CAPTION | WS_SYSMENUπCAPTION "Selected File Information"πFONT 8, "Helv"πBEGINπ CONTROL "OK", IDOK, "BUTTON", WS_GROUP, 56, 49, 32, 14π LTEXT "File(s) selected:", -1, 10, 7, 64, 8π LTEXT "Disk space taken:", -1, 10, 20, 64, 8π LTEXT " ", IDD_SELFILECOUNT, 77, 7, 56, 8π LTEXT " ", IDD_SELFILESIZE, 77, 20, 56, 8πENDππAboutExtension DIALOG 8, 21, 237, 215πSTYLE DS_MODALFRAME | WS_OVERLAPPED | WS_CAPTION | WS_SYSMENUπCAPTION "About Extension"πFONT 8, "Helv"πBEGINπ ICON "ExtensionIcon", -1, 5, 5, 16, 21π LTEXT "File Manager Extension DLL", -1, 34, 5, 150, 8π LTEXT "Version 1.0", -1, 34, 15 150, 8π LTEXT "Copyright \251 Microsoft Corp., 1992", -1, 34, 25, 150, 8π LTEXT "A File Manager extension is a Windows DLL that adds a menu to", -1, 5,π40, 232, 8π LTEXT "File Manager, contains entry point that processes menu commands", -1,π5, 50, 232, 8π LTEXT "and notification messages sent by File Manager, and queries data", -1,π5, 60, 232, 8π LTEXT "and information about the File Manager windows.", -1, 5, 70, 232, 8π LTEXT "Menu Options:", -1, 5, 85, 237, 8π LTEXT "Status Window\t\t- Shows/Hides status window", -1, 5, 98, 230, 8π LTEXT "Selected File(s) Size...\t- Displays disk space taken by the files",π-1, 5, 108, 230, 8π LTEXT "Selected Drive Info...\t- Displays selected drive information", -1, 5,π118, 230, 8π LTEXT "Focused Item Info...\t- Displays the name of the focused item", -1, 5,π128, 230, 8π LTEXT "Reload Extension\t- Reloads this extension", -1, 5, 138, 230, 8π LTEXT "Refresh Window\t- Refreshes File Manager's active window", -1, 5, 148,π230, 8π LTEXT "Refresh All Windows\t- Refreshes all the File Manager's windows", -1,π5, 158, 230, 8π LTEXT "About Extension...\t- Displays this dialog", -1, 5, 168, 230, 8π CONTROL "OK", IDOK, "BUTTON", WS_GROUP, 101, 190, 32, 14πENDππππDriveInfo DIALOG 22, 17, 188, 85πSTYLE DS_MODALFRAME | WS_OVERLAPPED | WS_CAPTION | WS_SYSMENUπCAPTION "Selected Drive Information"πFONT 8, "Helv"πBEGINπ CONTROL "OK", IDOK, "BUTTON", WS_GROUP, 77, 65, 32, 14π LTEXT "Path:", -1, 7, 6, 46, 8π LTEXT "Volume:", -1, 7, 16, 46, 8π LTEXT "Share:", -1, 7, 26, 46, 8π LTEXT "Total KBs:", -1, 7, 36, 46, 8π LTEXT "Free KBs:", -1, 7, 46, 46, 8π LTEXT " ", IDD_PATH, 61, 6, 120, 8π LTEXT " ", IDD_VOLUME, 61, 16, 120, 8π LTEXT " ", IDD_SHARE, 61, 26, 120, 8π LTEXT " ", IDD_TOTALSPACE, 61, 36, 120, 8π LTEXT " ", IDD_FREESPACE, 61, 46, 120, 8πENDππ---------- snip ---------- snip ---------- snip ----------ππππbegin 755 icon.zipπM4$L#!!0 ( "IC;!E>O+@&9@$ #X$ , 6%1%3E-)3TXN24-/K9,]πM;H- $(4'B!4D%\X-0A6E1.( ^!2IJ;B!:V]E(5ERKD))EST*E447I"B1"\>;πM-[,_%I:C1%$>/-8SWWH81D 444Q9%A,KCX@>L&;9G<0#TD_(/7(.7A+OCX3YπMY5+&F/ [,4=4GU%LWA6LQ?U*QZ\KN_H<S71B/F4-N1_VH@$=F9/ >T-NJBπM!W.@"";V&B[A^__V$3[!AJU@I^F\;J0G%5^?%XB<I)1=^. 4+EIK?AHY\5!VπMX<-,Y_R=YELK-;"(4I=O^49-1?/28K4_#/U04UIVK+;=G':JJ2MPW(;YF()7πMX$F1,Q\]1RQ\<!R%)]S5]_^7\8RA?B'*U1Y)YIU5NZGKBKF?D/0O]6U_4N9<πMOTF9?S!'OFN[? <]A_Z:0C:,OO^NR.U\RBVNS&WLZY^Y[3=PUV_@;KZ>+_P+πMX&)R?/OF8O^ +RX.&T;ZBXQ]"1;P+7]NWW^5OU5BKEG!&N[A$?;Z E!+ 0(4πM !0 ( "IC;!E>O+@&9@$ #X$ , ( !85$5.π>4TE/3BY)0T]02P4& $ 0 Z D $ π πendππ---------- END ---------- END ---------- END ---------- END ----------π 16 08-25-9409:13ALL WIEGER WESSELINK Word Wrapping In Windows SWAG9408 ╞q┌ç 11 Kx {πFrom: wieger@wsintt02.info.win.tue.nl (Wieger Wesselink)ππI have written the following program that contains a wordwrap editor thatπinherits from TFileWindow. The wordwrapping is achieved by modifying theπStyle field of the Editor-object in TFileWindow. This works fine exceptπfor one thing: saving the contents of the editor goes wrong. Sometimes theπlast line is truncated. Can anyone tell me how to fix this problem?πThanks in advance,ππ}πprogram WordWrap;ππuses WinTypes, OWindows, OStdWnds;ππtypeπ PMyFileWindow = ^TMyFileWindow;π TMyFileWindow = object(TFileWindow)π constructor Init(AParent: PWindowsObject; ATitle, AFileName: PChar);π end;ππ TMyApplication = object(TApplication)π procedure InitMainWindow; virtual;π end;ππconstructor TMyFileWindow.Init(AParent: PWindowsObject; ATitle,π AFileName: PChar);πbeginπ inherited Init(AParent, ATitle, AFileName);π with Editor^.Attr do beginπ Style := Style and not (es_AutoHScroll or ws_HScroll);π end;πend;ππprocedure TMyApplication.InitMainWindow;πbeginπ MainWindow := New(PMyFileWindow, Init(nil, 'WordWrapper', nil));πend;ππvarπ MyApp: TMyApplication;ππbeginπ MyApp.Init('WordWrap');π MyApp.Run;π MyApp.Done;πend.ππ
